home *** CD-ROM | disk | FTP | other *** search
- ;; -*-Emacs-Lisp-*-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;
- ;; File: efs-vos.el
- ;; Description: VOS support for efs
- ;; Release: $efs release: 1.15 $
- ;; Version: #Revision: 1.1 $
- ;; RCS:
- ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it>
- ;; Created: Sat Apr 3 03:05:00 1993 by sandy on ibm550
- ;; Modified: Sun Nov 27 18:45:24 1994 by sandy on gandalf
- ;; Language: Emacs-Lisp
- ;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;;; This file is part of efs. See efs.el for copyright
- ;;; (it's copylefted) and warrranty (there isn't one) information.
-
- ;;; The original ange-ftp VOS support was written by Joe Wells <jbw@cs.bu.edu>
-
- ;;; Thank you to Jim Franklin <jimf%shared@uunet.uu.net> for providing
- ;;; information on the VOS operating system.
-
- (provide 'efs-vos)
- (require 'efs)
-
- (defconst efs-vos-version
- (concat (substring "$efs release: 1.15 $" 14 -2)
- "/"
- (substring "#Revision: 1.1 $" 11 -2)))
-
- ;;;;---------------------------------------------------------------
- ;;;; VOS support for efs
- ;;;;---------------------------------------------------------------
-
- ;;; A legal VOS pathname is of the form:
- ;;; %systemname#diskname>dirname>dirname>dir-or-filename
- ;;;
- ;;; Each of systemname, diskname, dirname, dir-or-filename can be
- ;;; at most 32 characters.
- ;;; Valid characters are all alpha, upper and lower case, all digits,
- ;;; plus: @[]\^`{|}~"$+,-./:_
- ;;; restrictions: name cannot begin with hyphen (-) or period (.)
- ;;; name must not end with a period (.)
- ;;; name must not contain two adjacent periods (.)
- ;;;
- ;;; Invalid characters are:
- ;;; non-printing control characters
- ;;; SPACE and DEL
- ;;; !#%&'()*;<=>?
- ;;; all other ascii chars
- ;;;
- ;;; The full pathname must be less than or equal to 256 characters.
- ;;; VOS pathnames are CASE-SENSITIVE.
- ;;; The may be a directory depth limitation of 10 (newer versions may have
- ;;; eliminated this).
-
- ;;; entry points
-
- (efs-defun efs-fix-path vos (path &optional reverse)
- ;; Convert PATH from UNIX-ish to VOS.
- ;; If REVERSE given then convert from VOS to UNIX-ish.
- ;; Does crude checking for valid path syntax, but is by no means exhaustive.
- (efs-save-match-data
- (if reverse
- (if (string-match "^\\(\\(%[^#>%]+\\)?#[^>#%]+\\)?>[^>#%]" path)
- (let ((marker (1- (match-end 0)))
- (result "/")
- system drive)
- (if (match-beginning 1)
- (if (match-beginning 2)
- (setq system (substring path 1 (match-end 2))
- drive (substring path (1+ (match-end 2))
- (match-end 1)))
- (setq drive (substring 1 (match-end 1)))))
- (while (string-match ">" path marker)
- (setq result (concat result
- (substring path marker
- (match-beginning 0))
- "/")
- marker (match-end 0)))
- (if drive
- (if system
- (concat "/" system "/" drive result
- (substring path marker))
- (concat "/" drive result (substring path marker)))
- (concat result (substring path marker))))
- (error "Invalid VOS pathname %s" path))
- (if (string-match "^/\\([^/]+\\)/\\([^/]+\\)/[^/]" path)
- (let ((marker (1- (match-end 0)))
- (result (concat "%"
- (substring path
- (match-beginning 1)
- (match-end 1))
- "#"
- (substring path
- (match-beginning 2)
- (match-end 2))
- ">")))
- ;; I'm guessing that VOS doesn't have a directory syntax.
- (setq path (efs-internal-directory-file-name path))
- (while (string-match "/" path marker)
- (setq result
- (concat result
- (substring path marker
- (match-beginning 0))
- ">")
- marker (match-end 0)))
- (concat result (substring path marker)))
- (error "Cannot convert path %s to VOS." path)))))
-
- (efs-defun efs-fix-dir-path vos (dir-path)
- ;; Convert path from UNIX-ish to VMS ready for a DIRectory listing.
- (cond ((string-equal dir-path "/")
- (error "Cannot gork VOS system names"))
- ((string-match "^/[^/]/$" dir-path)
- (error "Cannot grok VOS devices"))
- ((efs-fix-path 'vos dir-path))))
-
- (defconst efs-vos-date-and-time-regexp
- (concat
- "\\(^\\| \\)" ; For links, this must match at the beginning of the line.
- "[678901][0-9]-[01][0-9]-[0-3][0-9] [012][0-9]:[0-6][0-9]:[0-6][0-9] "))
- ;; Regexp to match a VOS file line. The end of the regexp must correspond
- ;; to the start of the filename.
-
- (defmacro efs-vos-parse-filename ()
- ;; Return the VOS filename on the current line of a listing.
- ;; Assumes that the point is at the beginning of the line.
- ;; Return nil if no filename is found.
- (` (let ((eol (save-excursion (end-of-line) (point))))
- (and (re-search-forward efs-vos-date-and-time-regexp eol t)
- (buffer-substring (point) eol)))))
-
- (efs-defun efs-parse-listing vos
- (host user dir path &optional switches)
- ;; Parse the current buffer which is assumed to be in MultiNet FTP dir
- ;; format, and return a hashtable as the result. SWITCHES are never used,
- ;; but they must be specified in the argument list for compatibility
- ;; with the unix version of this function.
- ;; HOST = remote host name
- ;; USER = user name
- ;; DIR = directory in as a full remote path
- ;; PATH = directory in full efs path syntax
- ;; SWITCHES = ls switches (not relevant here)
- (goto-char (point-min))
- (efs-save-match-data
- (let (tbl file)
- ;; Look file files.
- (if (search-forward "\nFiles: " nil t)
- (progn
- (setq tbl (efs-make-hashtable))
- (forward-line 1)
- (skip-chars-forward "\n")
- (while (setq file (efs-vos-parse-filename))
- (efs-put-hash-entry file '(nil) tbl)
- (forward-line 1))))
- ;; Look for directories.
- (if (search-forward "\nDirs: " nil t)
- (progn
- (or tbl (setq tbl (efs-make-hashtable)))
- (forward-line 1)
- (skip-chars-forward "\n")
- (while (setq file (efs-vos-parse-filename))
- (efs-put-hash-entry file '(t) tbl)
- (forward-line 1))))
- ;; Look for links
- (if (search-forward "\nLinks: " nil t)
- (let (link)
- (or tbl (setq tbl (efs-make-hashtable)))
- (forward-line 1)
- (skip-chars-forward "\n")
- (while (setq file (efs-vos-parse-filename))
- (if (string-match " -> \\([^ ]+\\)" file)
- ;; VOS puts a trailing blank after the name of a symlink
- ;; target. Go figure...
- (setq link (substring file (match-beginning 1) (match-end 1))
- file (substring file 0 (match-beginning 0)))
- (setq link "")) ; weird?
- (efs-put-hash-entry file (list link) tbl)
- (forward-line 1))))
- ;; This returns nil if no headings for files, dirs, or links
- ;; are found. In this case, we're assuming that it isn't a valid
- ;; listing.
- (if tbl
- (progn
- (efs-put-hash-entry "." '(t) tbl)
- (efs-put-hash-entry ".." '(t) tbl)))
- tbl)))
-
- (efs-defun efs-allow-child-lookup vos (host user dir file)
- ;; Returns t if FILE in directory DIR could possibly be a subdir
- ;; according to its file-name syntax, and therefore a child listing should
- ;; be attempted.
- ;; Directoried don't have a size.
- (string-match ": not a file\\.$"
- (cdr (efs-send-size host user (concat dir file)))))
-
- ;;; Tree Dired Support
-
- (defconst efs-dired-vos-re-exe
- "^. +e ")
-
- (or (assq 'vos efs-dired-re-exe-alist)
- (setq efs-dired-re-exe-alist
- (cons (cons 'vos efs-dired-vos-re-exe)
- efs-dired-re-exe-alist)))
-
- (defconst efs-dired-vos-re-dir
- "^. +[nsm] +[0-9]+ +[678901][0-9]-")
-
- (or (assq 'vos efs-dired-re-dir-alist)
- (setq efs-dired-re-dir-alist
- (cons (cons 'vos efs-dired-vos-re-dir)
- efs-dired-re-dir-alist)))
-
- (efs-defun efs-dired-manual-move-to-filename vos
- (&optional raise-error bol eol)
- ;; In dired, move to the first char of filename on this line, where
- ;; line can be delimited by either \r or \n.
- ;; Returns (point) or nil if raise-error is nil and there is no
- ;; filename on this line. In the later case, leaves the point at the
- ;; beginning of the line.
- ;; This version is for VOS.
- (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
- (let (case-fold-search)
- (if bol
- (goto-char bol)
- (skip-chars-backward "^\n\r"))
- (if (re-search-forward efs-vos-date-and-time-regexp eol t)
- (point)
- (and raise-error (error "No file on this line")))))
-
- (efs-defun efs-dired-manual-move-to-end-of-filename vos
- (&optional no-error bol eol)
- ;; Assumes point is at the beginning of filename.
- ;; So, it should be called only after (dired-move-to-filename t)
- ;; On failure signals an error, or returns nil.
- ;; This is the VOS version.
- (let ((opoint (point)))
- (and selective-display
- (null no-error)
- (eq (char-after
- (1- (or bol (save-excursion
- (skip-chars-backward "^\r\n")
- (point)))))
- ?\r)
- ;; File is hidden or omitted.
- (cond
- ((dired-subdir-hidden-p (dired-current-directory))
- (error
- (substitute-command-keys
- "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
- ((error
- (substitute-command-keys
- "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
- )))))
- (skip-chars-forward "-a-zA-Z0-9@[]\\^`{|}~\"$+,./:_")
- (if (or (= opoint (point)) (not (memq (following-char) '(?\n ?\r ?\ ))))
- (if no-error
- nil
- (error "No file on this line"))
- (point))))
-
- (efs-defun efs-dired-fixup-listing vos (file path &optional switches wildcard)
- ;; VOS listing contain some empty lines, which is inconvenient for dired.
- (goto-char (point-min))
- (skip-chars-forward "\n")
- (delete-region (point-min) (point))
- (while (search-forward "\n\n" nil t)
- (forward-char -2)
- (delete-char 1)))
-
- (efs-defun efs-dired-ls-trim vos ()
- ;; Trims VOS dir listings for single files, so that they are exactly one line
- ;; long.
- (goto-char (point-min))
- (let (case-fold-search)
- (re-search-forward efs-vos-date-and-time-regexp))
- (beginning-of-line)
- (delete-region (point-min) (point))
- (forward-line 1)
- (delete-region (point) (point-max)))
-
- ;;; end of efs-vos.el
-